home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / JARP / ARPFileRequest.f < prev   
Encoding:
FORTH Source  |  1991-01-25  |  3.9 KB  |  147 lines
  1. \ Access ARP File Requester
  2. \ By Henry Lowengard, Nick Didkovsky, Phil Burk
  3. \ -------------------------------------------------
  4. \ Nick Didkovsky
  5. \ File requester for Script Supervisor Spreadsheet
  6. \ This code was pruned from Henry Lowengard's code.
  7. \ It calls the ARP file requester quickly and easily from JForth Pro v2.0
  8. \ Let me go on the record to say this file requester is great and I love it. 
  9. \ -------------------------------------------------
  10. \ Phil Burk
  11. \ Modified for JForth Pro 2.1, 1/25/91
  12.  
  13. getmodule includes
  14. \ include? LIBRARIES_ARPBASE_H jarp:ARP.j
  15.  
  16. anew task-arpfilerequester 
  17.  
  18. .NEED FileRequester    \ only load small part of ARP.J
  19. ( ************************* File Requester ***************************)
  20. ( **************** Submit the following to FileRequest[] *************)
  21. ( ********************************************************************)
  22.  
  23. 32  constant FCHARS (  Filename size )
  24. 33  constant DSIZE (  Directory name size )
  25.  
  26. :STRUCT FileRequester
  27.     APTR  fr_Hail        (  Hailing text            )
  28.     APTR  fr_File        (  Filename array [FCHARS * N]    )
  29.     APTR  fr_Dir        (  Directory array [DSIZE + 1]    )
  30.     APTR  fr_Window    (  Window requesting files or NULL)
  31.     BYTE  fr_FuncFlags        (  Set bitdef's below        )
  32.     BYTE  fr_reserved1        (  Set to NULL            )
  33. \ %?     VOID    (*fr_Function)();    /* Your function, see bitdef's    */    
  34.     LONG  fr_Function        (  RESERVED            )
  35.     LONG  fr_reserved2        (  RESERVED            )
  36. ;STRUCT 
  37.  
  38. .NEED ARP?
  39. \ classic library stuff
  40. :Library ARP
  41. : Arp? ARP_NAME ARP_LIB LIB? ;
  42. : -Arp ARP_LIB -LIB ;
  43. arp?
  44. if.forgotten -arp
  45. .THEN
  46.  
  47. .NEED 0MOVE
  48. : 0MOVE  ( 0string1 addr -- , move NUL terminated string to addr )
  49.     >r 0count r> swap 1+ move
  50. ;
  51. .THEN
  52.  
  53. FileRequester MyFileReq
  54. create Chail 64 allot
  55. create arp-filename FCHARS allot
  56. create arp-dir    DSIZE Allot
  57.  
  58. \ Your end-users will love you if you remember the last path/file used by
  59. \ this requester. ND
  60. variable arp-def-dir DSIZE Allot
  61. variable arp-def-file FCHARS allot
  62.  
  63. \ This is a JForth string,leading count byte, with path appended to filename
  64. CREATE full-arp-filename FCHARS Dsize + Allot
  65.  
  66. \ This appends the two null-terminated strings for Dir and Filename
  67. \ into one JForth-style string (leading count byte). 
  68. \ Takes care of dirs within dirs within dirs, etc
  69.  
  70. : BUILD.FULL.NAME ( -- , concatenate directory and filename )
  71.     full-arp-filename off
  72.     arp-dir 0count ?dup
  73.     IF
  74.         full-arp-filename $append
  75. \ add a '/' if no ':' at end
  76.         full-arp-filename count + 1- c@ ascii : = not
  77.         IF " /" count full-arp-filename $append
  78.         THEN
  79.     ELSE drop
  80.     THEN
  81.     arp-filename 0count full-arp-filename $append
  82. ;
  83.  
  84. : FileRequest() ( filereq -- flag )
  85.     >Abs call arp_lib FileRequest
  86. ;
  87.  
  88. \ Loads selected directory name into string called arp-dir
  89. \ Loads selected filename into string called arp-filename
  90. \ Leaves a flag on the stack, if 0, then 'cancel' was hit by user.
  91. \ Stores most recent dir in default dir, so you don't have to override
  92. \ defaults more than once per session.    ND
  93.  
  94. : FileRequest ( 0prompt window|0 -- $file true | false )
  95.     swap >abs MyFileReq ..! fr_Hail
  96. \
  97. \ set starting file
  98.     arp-def-file arp-filename 0move
  99.     arp-filename >abs MyFileReq ..! fr_File
  100. \
  101. \ set default directory
  102.     arp-def-dir arp-dir 0move
  103.     arp-dir >Abs MyFileReq ..! fr_dir
  104. \
  105.     if>abs MyFileReq ..! fr_Window    
  106.     0 MyFileReq ..! fr_FuncFlags
  107.     0 MyFileReq ..! fr_reserved1
  108.     0 MyFileReq ..! fr_Function
  109.     0 MyFileReq ..! fr_reserved2
  110.  
  111. \ This call leaves 0 on stack if cancel was hit. ND
  112.     arp_lib @ 0=
  113.     IF    arp?
  114.         arp_lib @ 0=
  115.         IF ." ARP Library not available!" cr false
  116.         ELSE    MyFileReq fileRequest()
  117.             -arp
  118.         THEN
  119.     ELSE    MyFileReq fileRequest()
  120.     THEN
  121.     
  122.     IF
  123. \ Update default dir and file names for the next time filerequest is used. ND
  124.         arp-dir arp-def-dir 0move
  125.         arp-filename arp-def-file 0move
  126. \
  127. \ appends dir and filename into one JForth string. ND
  128.         build.full.name
  129.         full-arp-filename c@ 0>
  130.         IF full-arp-filename true
  131.         ELSE false
  132.         THEN
  133.     ELSE
  134.         false
  135.     THEN
  136. ;
  137.  
  138. : GET.FILE ( -- $filename true | false )
  139.     0" Load file..." 0 FileRequest
  140. ;
  141.  
  142. : PUT.FILE ( -- $filename true | false )
  143.     0" Save file..." 0 FileRequest
  144. ;
  145.  
  146.  
  147.